home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD ROM Paradise Collection 4
/
CD ROM Paradise Collection 4 1995 Nov.iso
/
program
/
jx4nt123.zip
/
UTILS
/
UB2T.UTF
(
.txt
)
< prev
next >
Wrap
Null Bytes Alternating
|
1994-08-21
|
5KB
|
80 lines
\ ub2t.f .. convert Unicode BLOCK files to Unicode TEXT files
\ Copyright (c)1994 Jack J. Woehr
\ P.O. Box 51, Golden, Colorado 80402-0051
\ jax@well.sf.ca.us 72203.1320@compuserve.com
\ SYSOP RCFB (303) 278-0364 2400/9600/14400
\ All Rights Reserved
\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\ This is free software and can be modified and redistributed under
\ certain conditions described in the file COPYING.TXT. The
\ Disclaimer of Warranty and License for this free software are also
\ contained in the file COPYING.TXT.
\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\
\ $Revision: 1.2 $
\
MARKER ub2t.f
\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
\ Convert an entire Unicode BLOCK file to Unicode text file
\ by reading a line at a time and copying it appending CRLFs.
\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
BASE @ HEX
\ Describe how many lines we'll have to convert.
400 CONSTANT CHARS/BLOCK
10 CONSTANT LINES/BLOCK
\ Some string buffers
CREATE (CRLF) 0D C, 0A C,
CREATE NAMEBUFF 400 CHARS ALLOT
BASE !
\ Generic err handler
: FILE-IO-ERR? ( flag --)
IF -37 THROW THEN
;
\ Do a line from one file to the other, adding CRLF
: UB2T-LINE ( in-fid out-fid -- u)
>R \ save out-fid
PAD 64 ROT READ-FILE \ -- u ior R: -- out-fid
FILE-IO-ERR? \ -- u R: -- out-fid
DUP \ -- u u R: -- out-fid
IF \ -- u R: -- out-fid
DUP \ -- u u R: -- out-fid
PAD SWAP R@ WRITE-FILE \ -- u ior R: -- out-fid
FILE-IO-ERR? \ -- u R: -- out-fid
(CRLF) 2 R> WRITE-FILE \ -- u ior R: --
FILE-IO-ERR? \ -- u
ELSE \ -- 0 R: -- out-fid
R> DROP \ -- 0 R: --
THEN \ -- u|0
;
\ Usage: UB2T file1 file2
: UB2T ( "ccc" "ccc" --)
BL WORD COUNT
R/O OPEN-FILE FILE-IO-ERR? \ -- fid1
BL WORD COUNT
R/W BIN CREATE-FILE FILE-IO-ERR? \ -- fid1 fid2
OVER FILE-SIZE FILE-IO-ERR? \ -- fid1 fid2 ud
CHARS/BLOCK UM/MOD NIP \ -- fid1 fid2 n
LINES/BLOCK UM* DROP 0 \ -- fid1 fid2 n' 0
DO
2DUP UB2T-LINE
0= FILE-IO-ERR?
LOOP
CLOSE-FILE DROP CLOSE-FILE DROP
;
\ ~~~~~~~~~~~~~
\ End of ub2t.f
\ ~~~~~~~~~~~~~